1 Imports System.Text
2 Imports System.Data.OleDb
3 Imports System.Security.Cryptography
4
5 Public Class frmLogin
6 Dim connstring As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=|datadirectory|\sis.accdb"
7 Dim connect As New OleDbConnection
8 Dim countattempts As Integer = 5
9
10 #Region "Connections"
11 Public Sub openconnection()
12 If connect.State = ConnectionState.Closed Then
13 connect.ConnectionString = connstring
14 connect.Open()
15 ElseIf connect.State = ConnectionState.Open Then
16 Me.Refresh()
17 End If
18 End Sub
19
20 Public Sub closeconnection()
21 If connect.State = ConnectionState.Open Then
22 connect.Close()
23 ElseIf connect.State = ConnectionState.Closed Then
24 Me.Refresh()
25 End If
26 End Sub
27 #End Region
28
29 #Region "Form actions"
30 Private Sub frmLogin_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
31 closeconnection()
32 Me.Dispose()
33 Me.Close()
34 End Sub
35 Private Sub frmLogin_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
36 openconnection()
37 TimerDate.Start()
38
39 Dim updateqry As String = "UPDATE users SET access='LOGOUT'"
40 Dim updatecmd As New OleDbCommand
41 With updatecmd
42 .CommandText = updateqry
43 .Connection = connect
44 .ExecuteNonQuery()
45 End With
46 End Sub
47 #End Region
48
49 #Region "Timer"
50 Private Sub TimerDate_Tick(sender As System.Object, e As System.EventArgs) Handles TimerDate.Tick
51 lblTime.Text = TimeOfDay
52 lblDate.Text = Today.Date.ToString("dddd, dd MMMM yyyy")
53 End Sub
54 #End Region
55
56 #Region "LOGIN"
57 Private Sub btnLogin_Click(sender As System.Object, e As System.EventArgs) Handles btnLogin.Click
58 Dim uname As String = txtUsername.Text.Trim
59 Dim pass As String = txtPassword.Text.Trim
60
61 If uname = "" Or IsNothing(uname) = True Then
62 MsgBox("Please enter username", MessageBoxIcon.Warning, "Error")
63 txtUsername.Focus()
64 ElseIf uname.Length > 10 Then
65 MsgBox("Username can not have greater than 10 characters", MessageBoxIcon.Warning, "Error")
66 txtUsername.Focus()
67
68 ElseIf pass = "" Or IsNothing(pass) = True Then
69 MsgBox("Please enter password", MessageBoxIcon.Warning, "Error")
70 txtPassword.Focus()
71 ElseIf pass.Length > 20 Then
72 MsgBox("Password can not have greater than 20 characters", MessageBoxIcon.Warning, "Error")
73 txtPassword.Focus()
74
75 Else
76 Dim Ue As New UnicodeEncoding()
77 Dim ByteSourceText() As Byte = Ue.GetBytes(pass)
78 Dim Md5 As New MD5CryptoServiceProvider()
79 Dim ByteHash() As Byte = Md5.ComputeHash(ByteSourceText)
80 Convert.ToBase64String(ByteHash)
81 Dim hashPwd As String
82 hashPwd = Convert.ToBase64String(ByteHash)
83
84 Dim selectqry As String = "SELECT * FROM users WHERE uname='" + uname + "'"
85 Dim da As OleDbDataAdapter
86 da = New OleDbDataAdapter(selectqry, connect)
87 Dim dtset As DataSet
88 dtset = New DataSet
89 da.Fill(dtset, "users")
90 Dim dttable As DataTable
91 dttable = New DataTable
92 dttable = dtset.Tables("users")
93
94 Dim dbuname, dbpass, dbrole, dbstatus, dbaccess As String
95 For Each temprow In dttable.Rows
96 dbuname = temprow("uname").ToString
97 dbpass = temprow("upass").ToString
98 dbrole = temprow("role").ToString
99 dbstatus = temprow("status").ToString
100 dbaccess = temprow("access").ToString
101
102 If (StrComp(dbuname, uname) = 0) And (StrComp(dbpass, hashPwd) = 0) And (StrComp(dbrole, "Administrator") = 0) And (StrComp(dbstatus, "ACTIVE") = 0) And (StrComp(dbaccess, "LOGOUT") = 0) Then
103
104 Dim unamelog As String = uname
105 Dim activity As String = unamelog + " Logged in"
106 Dim activitydate As String = lblTime.Text + " " + lblDate.Text
107 Dim insertlog As String = "INSERT INTO logfiles VALUES('" + unamelog + "','" + activity + "','" + activitydate + "')"
108 Dim insertlogcmd As New OleDbCommand
109 With insertlogcmd
110 .CommandText = insertlog
111 .Connection = connect
112 .ExecuteNonQuery()
113 End With
114
115 Dim updateqry As String = "UPDATE users SET access='LOGIN' WHERE uname='" + uname + "'"
116 Dim updatecmd As New OleDbCommand
117 With updatecmd
118 .CommandText = updateqry
119 .Connection = connect
120 .ExecuteNonQuery()
121 End With
122
123 lbluname.Text = uname
124 frmAdminENG.Show()
125 clearinputs_login()
126 Me.Hide()
127 Exit Sub
128
129 ElseIf (StrComp(dbuname, uname) = 0) And (StrComp(dbpass, hashPwd) = 0) And (StrComp(dbrole, "Employee") = 0) And (StrComp(dbstatus, "ACTIVE") = 0) And (StrComp(dbaccess, "LOGOUT") = 0) Then
130 Dim unamelog As String = uname
131 Dim activity As String = unamelog + " Logged in"
132 Dim activitydate As String = lblTime.Text + " " + lblDate.Text
133 Dim insertlog As String = "INSERT INTO logfiles VALUES('" + unamelog + "','" + activity + "','" + activitydate + "')"
134 Dim insertlogcmd As New OleDbCommand
135 With insertlogcmd
136 .CommandText = insertlog
137 .Connection = connect
138 .ExecuteNonQuery()
139 End With
140
141 Dim updateqry As String = "UPDATE users SET access='LOGIN' WHERE uname='" + uname + "'"
142 Dim updatecmd As New OleDbCommand
143 With updatecmd
144 .CommandText = updateqry
145 .Connection = connect
146 .ExecuteNonQuery()
147 End With
148
149 lbluname.Text = uname
150 frmUserENG.Show()
151 clearinputs_login()
152 Me.Hide()
153 Exit Sub
154
155 ElseIf (StrComp(dbuname, uname) = 0) And (StrComp(dbpass, hashPwd) = 0) And (StrComp(dbrole, "Employee") = 0) And (StrComp(dbstatus, "ACTIVE") = 0) And (StrComp(dbaccess, "LOGIN") = 0) Then
156 MsgBox("You have already logged in using this ID on another computer", MessageBoxIcon.Warning, "Error")
157 clearinputs_login()
158 Exit Sub
159
160 ElseIf (StrComp(dbuname, uname) = 0) And (StrComp(dbpass, hashPwd) = 0) And (StrComp(dbrole, "Administrator") = 0) And (StrComp(dbstatus, "ACTIVE") = 0) And (StrComp(dbaccess, "LOGIN") = 0) Then
161 MsgBox("You have already logged in using this ID on another computer", MessageBoxIcon.Warning, "Error")
162 clearinputs_login()
163 Exit Sub
164
165 ElseIf (StrComp(dbuname, uname) = 0) And (StrComp(dbpass, hashPwd) = 0) And (StrComp(dbrole, "Employee") = 0) And (StrComp(dbstatus, "SUSPENDED") = 0) Then
166 MsgBox("Your account is suspended. Please contact administrator", MessageBoxIcon.Warning, "Error")
167 clearinputs_login()
168 Exit Sub
169
170 ElseIf (StrComp(dbuname, uname) = 0) And (StrComp(dbpass, hashPwd) = 0) And (StrComp(dbrole, "Administrator") = 0) And (StrComp(dbstatus, "SUSPENDED") = 0) Then
171 MsgBox("Your account is suspended. Please contact administrator", MessageBoxIcon.Warning, "Error")
172 clearinputs_login()
173 Exit Sub
174 ElseIf (StrComp(dbuname, uname) <> 0) Or (StrComp(dbpass, hashPwd) <> 0) Then
175 MsgBox("Wrong username or password", MessageBoxIcon.Warning, "Error")
176 clearinputs_login()
177 Exit Sub
178 End If
179 Next
180
181 End If
182 End Sub
183
184 #End Region
185
186 #Region "CLEAR"
187 Private Sub btnClear_Click(sender As System.Object, e As System.EventArgs) Handles btnClear.Click
188 clearinputs_login()
189 End Sub
190 #End Region
191
192 #Region "Clear inputs"
193 Private Sub clearinputs_login()
194 txtUsername.Clear()
195 txtPassword.Clear()
196 End Sub
197 #End Region
198
199 End Class
